30 Day Graphics Challenge

Author

Jhon Carlos Solis Ochoa

30 Day Challenge

Se cargan las librerias necesarias

Dia 1

Se tomaran los datos desde la fuente de datos libres del gobierno de Colombia

https://www.datos.gov.co/

Para este primer día se toma como referencia los dias hidrobiologicos y nos centraremos en el departamento de Bolivar

datos <- read_parquet("./temperatura_media_bolivar.parquet/part-00000-ab3570a7-e502-472d-aa94-39e00b4f5101-c000.snappy.parquet")
head(datos)
# A tibble: 6 × 4
  Municipio              Año   Mes TemperaturaMedia
  <chr>                <int> <int>            <dbl>
1 ARJONA                2020     1             28.0
2 EL GUAMO              2020     1             38.1
3 SANTA ROSA DEL SUR    2020     1             21.4
4 EL CARMÉN DE BOLÍVAR  2020     1             27.0
5 CARTAGENA DE INDIAS   2020     1             27.9
6 MAGANGUÉ              2022     8             26.9
#Datos filtrados 
datos_filtrados <- datos %>% filter( Año == 2020 & Mes == 1)
datos_filtrados <-  datos_filtrados %>% mutate(Porcentaje = TemperaturaMedia / sum(TemperaturaMedia) * 100)


ggplot(datos_filtrados, aes(x = "", y = Porcentaje, fill = Municipio)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y", start = 0) +
  labs(title = "Proporción de Temperatura Media por Municipio (Enero 2020)") +
  theme_void() +
  theme(legend.position = "right") +
  geom_text(aes(label = paste0(round(Porcentaje, 1), "%")), 
            position = position_stack(vjust = 0.5), size = 4, color = "white") +
  scale_fill_manual(values = c("#FF9999", "#66B3FF", "#99FF99", "#FFCC99", "#FFD700"))

Este gráfico de anillos muestra los porcentajes de temperatura media para cada municipio, con etiquetas de porcentaje en blanco directamente en cada sección. Los colores personalizados hacen que cada segmento sea fácilmente distinguible.

Dia 2

datos_resumidos <- datos_filtrados %>%
  group_by(Municipio) %>%
  summarise(TemperaturaMedia = mean(TemperaturaMedia, na.rm = TRUE))

# Convertir los datos a un formato ancho
datos_radar <- datos_resumidos %>%
  pivot_wider(names_from = Municipio, values_from = TemperaturaMedia)

# Agregar filas con los valores máximos y mínimos para definir los límites del gráfico
max_min <- data.frame(matrix(c(50, 0), ncol = ncol(datos_radar), nrow = 2))
colnames(max_min) <- colnames(datos_radar)

# Combinar los límites y los datos para el gráfico
datos_radar <- rbind(max_min, datos_radar)


par(mar = c(1, 1, 1, 1))  # Reducir los márgenes
par(cex = 1.24)  # Ajustar el tamaño general de la figura

# Crear el gráfico de radar
radarchart(datos_radar, 
           axistype = 1,
           pcol = c("skyblue", "pink"),  # Colores de las líneas
           pfcol = c(rgb(0.2, 0.5, 0.5, 0.5), rgb(0.8, 0.2, 0.5, 0.5)),  # Colores de relleno
           plwd = 2,  # Grosor de las líneas
           cglcol = "grey",  # Color de las líneas de la cuadrícula
           cglty = 1,  # Tipo de línea de la cuadrícula
           axislabcol = "grey",  # Color de los números en los ejes
           cglwd = 0.8,  # Grosor de las líneas de la cuadrícula
           vlcex = 0.6,  # Tamaño del texto de las etiquetas de los municipios
           cex.axis = 0.002)  # Tamaño de las etiquetas de los porcentajes en los ejes

Este gráfico de radar muestra la temperatura media promedio de cada municipio.

Día 3

Los datos se tomaron de la publicación de la graficas de intención de votos en la revista Semana de Colombia, con relación de las elecciones presidenciales del año 2022, donde manipulaban los graficos para difundir informacion real pero sesgada para inducir al error.

# Datos originales
datos_candidatos <- data.frame(
  Candidato = c("Petro", "Fajardo", "Maria Lucia", "Char", "Galan", "Fico"),
  Porcentaje = c(23, 12, 9, 6, 6, 5)
)

# Gráfico ajustado (haciendo que los porcentajes más bajos se acerquen al más alto)
# Escalamos los valores de forma que se vean más parejos
max_porcentaje <- max(datos_candidatos$Porcentaje)  # Tomamos el valor máximo
datos_ajustados <- datos_candidatos %>%
  mutate(Porcentaje_Ajustado = ifelse(Porcentaje < max_porcentaje, 
                                      Porcentaje + (max_porcentaje - Porcentaje) * 0.8, 
                                      Porcentaje))  # Solo ajustamos los porcentajes menores


# Gráfico ajustado
ggplot(datos_ajustados, aes(x = reorder(Candidato, Porcentaje_Ajustado), y = Porcentaje_Ajustado, fill = Candidato)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = paste0(round(Porcentaje, 1), "%")), vjust = -0.3) +
  labs(title = "Porcentajes Ajustados de Candidatos") +
  theme_minimal() +
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = "none")

# Gráfico con valores reales
ggplot(datos_candidatos, aes(x = reorder(Candidato, Porcentaje), y = Porcentaje, fill = Candidato)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = paste0(Porcentaje, "%")), vjust = -0.3) +
  labs(title = "Porcentajes Reales de Candidatos") +
  scale_y_continuous(breaks = seq(0, 50, 10), limits = c(0, 50)) +
  theme_minimal() +
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = "none")

Día 4

datos_filtrados <- datos %>%
  filter(Año == 2022, Mes == 7)

# Crear los rangos de temperatura
rangos_temperatura <- cut(datos_filtrados$TemperaturaMedia, 
                          breaks = c(15, 20, 25, 30, 35, 40), 
                          labels = c("15-20°C", "20-25°C", "25-30°C", "30-35°C", "35-40°C"))

# Contar la cantidad de ocurrencias de cada rango de temperatura
distribucion_temperaturas <- table(rangos_temperatura)

# Crear el gráfico de Waffle usando la librería waffle
waffle(distribucion_temperaturas, 
       rows = 10, 
       colors = c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd"),
       title = "Distribución de Temperaturas para Julio 2022",
       xlab = "Días") +
  theme(
    plot.title = element_text(size = 10, hjust = 0.5)  
  )

Este gráfico mostrará la distribución de las temperaturas en julio de 2022, con cada “cuadro” representando un día del mes según los rangos de temperatura establecidos.

Día 5

# Filtrar los datos entre 2018 y 2022
datos_filtrados <- datos %>%
  filter(Año >= 2018, Año <= 2022)

# Calcular la temperatura promedio por año
promedio_temperaturas <- datos_filtrados %>%
  group_by(Año) %>%
  summarise(TemperaturaPromedio = mean(TemperaturaMedia, na.rm = TRUE))

# Calcular la temperatura promedio general para todo el período (2018-2022)
temperatura_promedio_general <- mean(promedio_temperaturas$TemperaturaPromedio)

# Calcular la diferencia de cada año con respecto a la temperatura promedio general
promedio_temperaturas <- promedio_temperaturas %>%
  mutate(Diferencia = TemperaturaPromedio - temperatura_promedio_general)

# Crear el gráfico divergente
ggplot(promedio_temperaturas, aes(x = Año, y = Diferencia, fill = Diferencia)) +
  geom_bar(stat = "identity") +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
  labs(title = "Divergencia de Temperaturas (2018-2022)", 
       x = "Año", 
       y = "Diferencia con el Promedio General") +
  theme_minimal() +
  theme(axis.title = element_text(size = 12),
        plot.title = element_text(size = 16, hjust = 0.5))

En el gráfico anterior, se puede ver de manera clara cómo varia la temperatura media en cada año con respecto al promedio general de todo el período (2018-2022).

Día 6

Se utilizarán los datos de la OCDE, que permite medir la tasa de empleo de un grupo de personas, clasificadas por su lugar de nacimiento y nivel educativo.

OCDE

data_ocde <- read_csv("empleoOCDE.csv", show_col_types = FALSE)
head(data_ocde)
# A tibble: 6 × 30
  STRUCTURE STRUCTURE_ID         STRUCTURE_NAME ACTION REF_AREA `Reference area`
  <chr>     <chr>                <chr>          <chr>  <chr>    <chr>           
1 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      ITA      Italy           
2 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      ITA      Italy           
3 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      DNK      Denmark         
4 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      GRC      Greece          
5 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      GRC      Greece          
6 DATAFLOW  OECD.ELS.IMD:DSD_MI… Employment, u… I      EST      Estonia         
# ℹ 24 more variables: CITIZENSHIP <chr>, Citizenship <chr>, FREQ <chr>,
#   `Frequency of observation` <chr>, MEASURE <chr>, Measure <chr>, SEX <chr>,
#   Sex <chr>, BIRTH_PLACE <chr>, `Place of birth` <chr>, EDUCATION_LEV <chr>,
#   `Education level` <chr>, UNIT_MEASURE <chr>, `Unit of measure` <chr>,
#   TIME_PERIOD <dbl>, `Time period` <lgl>, OBS_VALUE <dbl>,
#   `Observation value` <lgl>, OBS_STATUS <chr>, `Observation status` <chr>,
#   UNIT_MULT <dbl>, `Unit multiplier` <chr>, DECIMALS <lgl>, Decimals <lgl>

Este gráfico comparativo permite ver de manera clara el porcentaje de empleo por sexo en cada uno de los países latinoamericanos presentes en la OCDE para el año 2021.

Día 7

Mapa de calor desastres naturales

data_desastres <- read_csv("EVENTOS_POR_DESASTRES_NATURALES_Y_ANTR_PICOS__Hist_rico__20241108.csv", show_col_types = FALSE)
head(data_desastres)
# A tibble: 6 × 28
  `FECHA DE OCURRENCIA`  `ESTADO DEL EVENTO` `FECHA DE CONCLUSION`  
  <chr>                  <chr>               <chr>                  
1 01/10/2020 12:00:00 AM ATENDIDO            2020-01-10T00:00:00.000
2 01/12/2020 12:00:00 AM ATENDIDO            2020-01-12T00:00:00.000
3 01/12/2020 12:00:00 AM ATENDIDO            2020-01-12T00:00:00.000
4 01/13/2020 12:00:00 AM ATENDIDO            2020-01-14T00:00:00.000
5 01/14/2020 12:00:00 AM ATENDIDO            2020-01-14T00:00:00.000
6 01/17/2020 12:00:00 AM ATENDIDO            2020-01-17T00:00:00.000
# ℹ 25 more variables: `TIPO DE EVENTO` <chr>, `CAUSA PROBABLE` <chr>,
#   `CONOCIDO/ATENDIDO` <chr>, `AUTORIDAD AMBIENTAL` <chr>, MUNICIPIO <chr>,
#   `AREA DE INCIDENCIA` <chr>, `BARRIO/VEREDA/CORREGIMIENTO` <chr>,
#   `FAMILIAS AFECTADAS / DAMNIFICADAS` <dbl>, `VIVIENDAS DESTRUIDAS` <chr>,
#   `VIVIENDAS AVERIADAS` <chr>, `ACUEDUCTOS DESTRUIDOS` <chr>,
#   `VIAS AFECTADAS` <chr>, `PUENTES OBSTRUIDOS/AFECTADOS` <chr>,
#   `ESTABLECIMIENTOS EDUCATIVOS AFECTADOS` <chr>, …

Dia 8

Mapa circular, con la temperatura de Cartagena de Indias desde el año 2020 a 2021

datos_filtrados <- datos %>%
  filter(Año %in% c(2020, 2021)) %>%
  filter(Municipio %in% c("CARTAGENA DE INDIAS", "ARJONA", "EL GUAMO", "SANTA ROSA DEL SUR", "MAGANGUÉ"))

# Calcular la temperatura promedio por municipio
temperatura_promedio <- datos_filtrados %>%
  group_by(Municipio) %>%
  summarise(TemperaturaPromedio = mean(TemperaturaMedia))

# Clasificar las temperaturas en tres categorías
temperatura_promedio <- temperatura_promedio %>%
  mutate(Rango = case_when(
    TemperaturaPromedio >= 30 ~ "Alta (>= 30°C)",
    TemperaturaPromedio >= 25 & TemperaturaPromedio < 30 ~ "Media (25-29°C)",
    TRUE ~ "Baja (< 25°C)"
  ))

# Calcular el total de registros
total_municipios <- nrow(temperatura_promedio)

# Calcular los porcentajes de cada categoría
temperatura_promedio <- temperatura_promedio %>%
  group_by(Rango) %>%
  summarise(Cantidad = n()) %>%
  mutate(Porcentaje = (Cantidad / total_municipios) * 100)

# Crear el gráfico circular con los porcentajes
ggplot(temperatura_promedio, aes(x = "", y = Porcentaje, fill = Rango)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar(theta = "y") +
  labs(title = "Distribución de Temperaturas Promedio por Municipio (2020-2021)",
       fill = "Rango de Temperatura") +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5)) +
  geom_text(aes(label = paste0(round(Porcentaje, 1), "%")), 
            position = position_stack(vjust = 0.5), color = "white", size = 5)

Día 9

Grafico de barras para valores extremos

datos_filtrados <- datos %>%
  filter(Municipio %in% c("CARTAGENA DE INDIAS", "ARJONA", "EL GUAMO", "SANTA ROSA DEL SUR", "MAGANGUÉ"))

# Calcular la temperatura promedio por municipio
temperatura_promedio <- datos_filtrados %>%
  group_by(Municipio) %>%
  summarise(TemperaturaPromedio = mean(TemperaturaMedia))

# Identificar los valores extremos
max_temp <- max(temperatura_promedio$TemperaturaPromedio)
min_temp <- min(temperatura_promedio$TemperaturaPromedio)

# Crear gráfico de barras con los valores extremos resaltados
ggplot(temperatura_promedio, aes(x = Municipio, y = TemperaturaPromedio, fill = TemperaturaPromedio)) +
  geom_col(color = "black") +
  scale_fill_gradient2(low = "blue", high = "red", midpoint = mean(temperatura_promedio$TemperaturaPromedio)) +
  geom_col(data = subset(temperatura_promedio, TemperaturaPromedio == max_temp), 
           aes(x = Municipio, y = TemperaturaPromedio), fill = "red", color = "black") +
  geom_col(data = subset(temperatura_promedio, TemperaturaPromedio == min_temp), 
           aes(x = Municipio, y = TemperaturaPromedio), fill = "blue", color = "black") +
  labs(title = "Temperaturas Promedio por Municipio",
       x = "Municipio", y = "Temperatura Promedio (°C)") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Día 10

Histograma de exportaciones no tradicionales

Día 11

Diseño simple de un gráfico adaptado para móviles.

ggplot(data_2023, aes(x = `Exportaciones en valor (Miles USD FOB)`)) +
  geom_density(fill = "steelblue", color = "black", alpha = 0.7) +
  labs(title = "Distribución de Exportaciones en Valor (Miles USD FOB)",
       x = "Exportaciones en Valor (Miles USD)",
       y = "Densidad") +
  theme_minimal() +
  theme(axis.text.x = element_text(size = 8),  # Reducir tamaño de las etiquetas del eje X
        axis.text.y = element_text(size = 8),  # Reducir tamaño de las etiquetas del eje Y
        plot.title = element_text(size = 10))  # Reducir tamaño del título

Día 12

Grafico del dia

Día 13

Diagrama de árbol que muestre relaciones de parentesco o conexiones

Día 14

Línea de tiempo de las exportaciones

Día 15

Mapa de calor de origen de exportaciones

Día 16

Grafico de dispersión

Día 17

Diagrama de redes

Día 18

Se mostraran los datos de inflación de la sub región Este de Asía, el set de datos se obtuvo en

Asian Development Bank (ADO)

data_inflacion <- read.csv("ADOSep2024_A2-Inflation.csv")

data_inflacion_filtered <- data_inflacion %>%
  filter(Subregion == "East Asia" & 
         Year %in% 2021:2024 & 
         !is.na(Country.Code) & 
         Country.Code != "")


ggplot(data_inflacion_filtered, aes(x = Year, y = Inflation, color = Country.Code, group = Country.Code)) +
  geom_line(size = 1) +      # Línea para la inflación por país
  geom_point(size = 3) +     # Puntos para resaltar los valores
  labs(title = "Comportamiento Anual de la Inflación en East Asia (2021-2024)",
       x = "Año",
       y = "Inflación (%)") +
  scale_color_viridis_d() +  # Asignar colores diferentes a cada país
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Rotar etiquetas del eje X

Día 19

Grafico de extinsion de los dinoraurios

Día 20

Grafico de correlación

Día 21

Energias renovables

proyectos <- read.csv("EnergiRenovable.csv")

# Asegurarse de que la columna 'Fecha estimada FPO' esté en formato de fecha
proyectos$Fecha_estimado_FPO <- as.Date(substr(proyectos$Fecha.estimada.FPO, 1, 10))


fecha_inicio <- as.Date("2018-01-01")
fecha_limite <- as.Date("2028-12-31")

# Filtrar proyectos con fecha de FPO válida y que estén dentro del rango de fechas especificado
proyectos_filtrados <- proyectos %>%
  filter(!is.na(Fecha_estimado_FPO) & Fecha_estimado_FPO >= fecha_inicio & Fecha_estimado_FPO <= fecha_limite)

# Crear gráfico
ggplot(proyectos_filtrados, aes(x = Fecha_estimado_FPO, y = Capacidad, color = Tipo)) +
  geom_point(aes(size = Capacidad), alpha = 0.8) +  # Puntos por cada proyecto, tamaño por capacidad
  geom_line(aes(group = 1), color = "grey70", linetype = "dashed") +  # Línea de tiempo
  scale_x_date(
    date_labels = "%Y",           # Solo mostrar el año
    date_breaks = "5 years",      # Intervalos de 5 años
    limits = c(fecha_inicio, fecha_limite),  # Rango de fechas entre 2018 y 2043
    expand = c(0, 0)              # Eliminar el espacio extra antes del primer y después del último año
  ) +
  labs(
    title = "Línea de Tiempo del Uso de Energías Renovables en Colombia",
    subtitle = "Proyectos de Energías Renovables desde 2018 hasta 2043",
    x = "Fecha de Puesta en Operación (FPO)",
    y = "Capacidad Instalada (MW)",
    color = "Tipo de Energía",
    size = "Capacidad"
  ) +
  theme_minimal() +  # Tema minimalista
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, size = 12),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text = element_text(size = 12),
    legend.title = element_text(size = 12, face = "bold"),
    legend.text = element_text(size = 10)
  ) +
  scale_color_manual(values = c("Solar" = "#FFB31C", "Eólico" = "#00B0B9"))

Día 22

Movilidad

# Ejemplo de datos de movilidad (puedes adaptar esto a tus datos reales)
movilidad <- data.frame(
  Fecha = seq(as.Date("2020-01-01"), by = "month", length.out = 25),  # 25 meses
  Vehiculos = c(5000, 5200, 5500, 5700, 6000, 6300, 6600, 6900, 7200, 7500, 
                7800, 8100, 8400, 8600, 8800, 9100, 9300, 9500, 9700, 10000, 
                10300, 10600, 10900, 11200, 11500),  # Número de vehículos
  Pasajeros = c(4500, 4700, 4950, 5100, 5300, 5600, 5900, 6100, 6400, 6700,
                6900, 7200, 7400, 7600, 7800, 8000, 8200, 8400, 8600, 8800,
                9000, 9200, 9400, 9600, 9800)  # Número de pasajeros
)

# Crear gráfico de líneas para mostrar las tendencias de vehículos y pasajeros
ggplot(movilidad, aes(x = Fecha)) +
  geom_line(aes(y = Vehiculos, color = "Vehículos"), size = 1.2) +  # Línea de vehículos
  geom_line(aes(y = Pasajeros, color = "Pasajeros"), size = 1.2) +  # Línea de pasajeros
  labs(
    title = "Tendencia de Movilidad a lo Largo del Tiempo",
    subtitle = "Número de vehículos y pasajeros en el transporte durante 2 años",
    x = "Fecha",
    y = "Cantidad",
    color = "Indicadores"
  ) +
  scale_color_manual(values = c("Vehículos" = "#1f77b4", "Pasajeros" = "#ff7f0e")) +  # Colores para las líneas
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, size = 12),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text = element_text(size = 12),
    legend.title = element_text(size = 12, face = "bold"),
    legend.text = element_text(size = 10)
  )

Día 23

Grafico de cuadriculas

Día 24

Africa

africa <- read.csv("womenManagerPositionAK.csv", quote = "\"")

Día 25

datos <- temperatura_data_clean

datos$FechaObservacion <- as.POSIXct(datos$FechaObservacion, format = "%Y-%m-%d %H:%M:%S")

datos_agg <- datos %>%
  group_by(FechaObservacion) %>%
  summarize(
    media = mean(ValorObservado, na.rm = TRUE),
    sd = sd(ValorObservado, na.rm = TRUE)
  ) %>%
  ungroup()

# Calcular intervalo de confianza (suponiendo distribución normal)
# Usaremos un intervalo de confianza del 95%
datos_agg <- datos_agg %>%
  mutate(
    ci_lower = media - 1.96 * (sd / sqrt(n())),
    ci_upper = media + 1.96 * (sd / sqrt(n()))
  )


ggplot(datos_agg, aes(x = FechaObservacion)) +
  geom_line(aes(y = media), color = "blue", size = 1) +  # Línea de tendencia
  geom_ribbon(aes(ymin = ci_lower, ymax = ci_upper), fill = "blue", alpha = 0.3) +  # Banda de incertidumbre
  labs(
    title = "Incertidumbre en las Proyecciones de Cambio Climático",
    subtitle = "Intervalo de confianza (95%) para los valores observados",
    x = "Fecha de Observación",
    y = "Valor Observado"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, size = 12),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text = element_text(size = 12)
  )

Día 26

IA

dengue_features <- read.csv("dengue_features_train.csv")


dengue_features$rolling_precip_3w <- zoo::rollapply(dengue_features$station_precip_mm, width = 3, FUN = mean, fill = NA, align = "right", partial = TRUE)
dengue_features$rolling_temp_avg_3w <- zoo::rollapply(dengue_features$station_avg_temp_c, width = 3, FUN = mean, fill = NA, align = "right", partial = TRUE)

# Rango de temperatura (máxima - mínima)
dengue_features$temp_range <- dengue_features$station_max_temp_c - dengue_features$station_min_temp_c

# Diferencia semanal de precipitación
dengue_features$precip_diff <- c(0, diff(dengue_features$station_precip_mm))

# Media móvil para NDVI
ndvi_columns <- c('ndvi_ne', 'ndvi_nw', 'ndvi_se', 'ndvi_sw')
for (col in ndvi_columns) {
  dengue_features[[paste0("rolling_", col, "_3w")]] <- zoo::rollapply(dengue_features[[col]], width = 3, FUN = mean, fill = NA, align = "right", partial = TRUE)
}

# Desviación estándar móvil de la temperatura promedio en 3 semanas
dengue_features$temp_std_3w <- zoo::rollapply(dengue_features$station_avg_temp_c, width = 3, FUN = sd, fill = NA, align = "right", partial = TRUE)

# Función para detección y capping de outliers
detect_and_cap_outliers_v2 <- function(df, column) {
  Q1 <- quantile(df[[column]], 0.25, na.rm = TRUE)
  Q3 <- quantile(df[[column]], 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  lower_bound <- Q1 - 1.5 * IQR
  upper_bound <- Q3 + 1.5 * IQR
  # Cap valores
  df[[column]] <- pmin(pmax(df[[column]], lower_bound), upper_bound)
  return(df)
}

# Aplicar capping a todas las columnas numéricas relacionadas con temperatura, precipitación y NDVI
columns_to_cap <- c('station_max_temp_c', 'station_min_temp_c', 'station_precip_mm',
                    'reanalysis_air_temp_k', 'reanalysis_avg_temp_k', 'reanalysis_max_air_temp_k',
                    'reanalysis_min_air_temp_k', 'reanalysis_precip_amt_kg_per_m2', 'reanalysis_tdtr_k',
                    'rolling_temp_avg_3w', 'temp_range', 'precip_diff',
                    'temp_std_3w', ndvi_columns)


# Aplicar la función detect_and_cap_outliers_v2 a cada columna de interés
for (column in columns_to_cap) {
  dengue_features <- detect_and_cap_outliers_v2(dengue_features, column)
}
temp_columns <- c('station_max_temp_c', 'station_min_temp_c', 'station_avg_temp_c', 'station_diur_temp_rng_c',
                  'reanalysis_air_temp_k', 'reanalysis_avg_temp_k', 'reanalysis_dew_point_temp_k',
                  'reanalysis_max_air_temp_k', 'reanalysis_min_air_temp_k', 'reanalysis_tdtr_k')

for (col in temp_columns) {
  dengue_features[[col]] <- zoo::na.approx(dengue_features[[col]], na.rm = FALSE)
}

# Forward fill para columnas de precipitación, donde los valores pueden ser abruptos
precip_columns <- c('station_precip_mm', 'precipitation_amt_mm', 
                    'reanalysis_precip_amt_kg_per_m2', 'reanalysis_sat_precip_amt_mm')

for (col in precip_columns) {
  dengue_features[[col]] <- zoo::na.locf(dengue_features[[col]], na.rm = FALSE)
}

# Imputación de la mediana para características derivadas y columnas NDVI
derived_columns <- c('rolling_precip_3w', 'rolling_temp_avg_3w', 'temp_range', 'precip_diff', 
                     'ndvi_ne', 'ndvi_nw', 'ndvi_se', 'ndvi_sw', 
                     'rolling_ndvi_ne_3w', 'rolling_ndvi_nw_3w', 'rolling_ndvi_se_3w', 'rolling_ndvi_sw_3w', 'temp_std_3w')

for (col in derived_columns) {
  dengue_features[[col]] <- ifelse(is.na(dengue_features[[col]]), 
                                   median(dengue_features[[col]], na.rm = TRUE), 
                                   dengue_features[[col]])
}

# Interpolación lineal para columnas de humedad relativa y específica
humidity_columns <- c('reanalysis_relative_humidity_percent', 'reanalysis_specific_humidity_g_per_kg')

for (col in humidity_columns) {
  dengue_features[[col]] <- zoo::na.approx(dengue_features[[col]], na.rm = FALSE)
}

# Verificar si quedan valores faltantes
missing_values_post_imputation <- colSums(is.na(dengue_features))
if(!require("caret")) install.packages("caret")
Cargando paquete requerido: caret
Cargando paquete requerido: lattice
Registered S3 methods overwritten by 'pROC':
  method    from
  print.roc fmsb
  plot.roc  fmsb

Adjuntando el paquete: 'caret'
The following object is masked from 'package:purrr':

    lift
library(caret)


# Eliminar columnas duplicadas en df_clustering
df_clustering <- dengue_features %>% select(-which(duplicated(names(.))))

# Convertir 'city' en factor (Verifica que la columna "city" exista)
if("city" %in% colnames(df_clustering)) {
  df_clustering <- df_clustering %>% mutate(city = as.factor(city))
} else {
  warning("La columna 'city' no existe en el dataset.")
}

# Crear modelo de variables dummy para 'city'
if("city" %in% colnames(df_clustering)) {
  dummy_model <- dummyVars(~ city, data = df_clustering)

  # Generar las variables dummy y combinarlas con el dataset original
  city_dummies <- predict(dummy_model, newdata = df_clustering)
  df_clustering <- cbind(df_clustering, as.data.frame(city_dummies))
} else {
  warning("La columna 'city' no existe, no se generaron variables dummy.")
}

# Verifica si las columnas de temperatura y NDVI existen antes de seleccionarlas
columns_temperatura_ndvi <- c("station_max_temp_c", "station_min_temp_c", "ndvi_ne", "ndvi_nw", "ndvi_se", "ndvi_sw")
if(all(columns_temperatura_ndvi %in% colnames(df_clustering))) {
  variables_temperatura_ndvi <- df_clustering %>%
    select(all_of(columns_temperatura_ndvi))
} else {
  warning("Algunas columnas de temperatura y NDVI no existen en el dataset.")
}

# Si se han seleccionado correctamente las variables de temperatura y NDVI, aplicar PCA
if(exists("variables_temperatura_ndvi")) {
  pca <- prcomp(variables_temperatura_ndvi, center = TRUE, scale. = TRUE)
  df_clustering$pca_temp_ndvi_1 <- pca$x[, 1]
  df_clustering$pca_temp_ndvi_2 <- pca$x[, 2]
} 

# Verifica que las columnas que deseas eliminar existan en el dataframe antes de proceder
columns_to_remove <- c("station_max_temp_c", "station_min_temp_c", "ndvi_ne", "ndvi_nw", 
                       "ndvi_se", "ndvi_sw", "rolling_ndvi_ne_3w", "rolling_ndvi_nw_3w", 
                       "rolling_ndvi_se_3w", "rolling_ndvi_sw_3w")

# Verifica que las columnas existen en el dataframe antes de eliminarlas
existing_columns <- columns_to_remove[columns_to_remove %in% colnames(df_clustering)]

if(length(existing_columns) > 0) {
  df_clustering <- df_clustering %>%
    select(-all_of(existing_columns))
} 
KMeans - Silhouette Score: 0.3071

Algoritmo de clustering, desarrollado siguiendo los lineamientos del reto DrivenData, ejercicio desarrollado en clase de Machine Learning de este mismo master.

Día 27

El gráfico de barras permite visualizar la distribución de los estados de vegetación en el conjunto de datos de dengue. Este gráfico ayuda a comparar cuántos registros corresponden a cada clasificación de vegetación en el dataset.

Día 28

Tendencia

proyectos_filtrados <- proyectos_filtrados %>%
  arrange(Fecha_estimado_FPO) %>%
  group_by(Tipo) %>%
  mutate(
    capacidad_media = rollmean(Capacidad, 12, fill = NA, align = "right"),  # Media móvil de 12 meses
    capacidad_sd = rollapply(Capacidad, 12, sd, fill = NA, align = "right")  # Desviación estándar
  ) %>%
  ungroup()

# Crear el gráfico con incertidumbre en las proyecciones
ggplot(proyectos_filtrados, aes(x = Fecha_estimado_FPO, y = capacidad_media, color = Tipo)) +
  geom_line(size = 1) +  # Línea de tendencia
  geom_ribbon(aes(ymin = capacidad_media - capacidad_sd, ymax = capacidad_media + capacidad_sd, fill = Tipo), 
              alpha = 0.2) +  # Área sombreada para incertidumbre
  labs(
    title = "Tendencia de Capacidad Instalada de Energías Renovables",
    subtitle = "Proyección con incertidumbre en las estimaciones de capacidad instalada",
    x = "Fecha de Puesta en Operación (FPO)",
    y = "Capacidad Instalada (MW)",
    fill = "Tipo de Energía",
    color = "Tipo de Energía"
  ) +
  theme_minimal() +  # Tema minimalista
  theme(
    plot.title = element_text(hjust = 0.5, size = 12, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text = element_text(size = 10),
    legend.title = element_text(size = 12, face = "bold"),
    legend.text = element_text(size = 10)
  ) +
  scale_color_manual(values = c("Solar" = "#FFB31C", "Eólico" = "#00B0B9")) +  # Colores para los tipos de energía
  scale_fill_manual(values = c("Solar" = "#FFB31C", "Eólico" = "#00B0B9")) 
Warning: Removed 22 rows containing missing values or values outside the scale range
(`geom_line()`).

Día 29

Grafico de contrastes, aprovecharemos la información utilizada para el desempleo en la OCDE para generar este grafico

datos_agrupados <- datos_agrupados %>%
  mutate(label_color = ifelse(Sex == "Total", "white", "black"))

# Gráfico de barras apiladas para empleo por género con porcentajes en cada barra
ggplot(datos_agrupados, aes(x = `Reference area`, y = Porcentaje_Empleo, fill = Sex)) +
  geom_bar(stat = "identity", position = "stack", width = 0.7) +  # Apilar las barras
  scale_fill_manual(values = c("Female" = "gray60",  
                               "Male" = "gray90",    
                               "Total" = "gray30")) +  
  labs(title = "Empleo por Género en Países Latinoamericanos de la OCDE",
       x = "País", fill = "Género") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),  # Rotar nombres de los países
        axis.title.y = element_blank()) +  # Eliminar eje Y
  geom_text(aes(label = paste0(round(Porcentaje_Empleo, 1), "%"), color = label_color), 
            position = position_stack(vjust = 0.5), 
            size = 3) + 
  scale_color_identity()

Día 30 FiveThirtyEight

Los datos utilizados en este grafico son resultado del proceso de Predicción de contagios de Dengue visto en la clase de Machine Learning, no hicimos todo el proceso de analisis solo tomamos como referencia el resultado final del ejercicio.

Este gráfico muestra los casos de dengue en San Juan y como estos han evolucionado a lo largo del tiempo (por semanas), con un color suave que no distrae la atención de los datos. Es fácil de leer y sigue el estilo claro y conciso de FiveThirtyEight.